Neil Pettinger / John MacKintosh
2018-05-07
library(tidyverse) # a suite of packages with common conventions
library(lubridate) # better handling of dates
library(scales) # easier plot scales
library(readxl) # easy import from Excel
library(hrbrthemes) # custom plot theme
library(extrafont) # loads fonts required for hrbrthemes on Windows
data <- read_xlsx("RedGreenGreyDots.xlsx", sheet = "Data (0)")
str(data) #could also have used glimpse(data)
Classes 'tbl_df', 'tbl' and 'data.frame': 684 obs. of 7 variables:
$ MovementDateTime: POSIXct, format: "2014-09-03 00:01:00" "2014-09-03 00:03:00" ...
$ FirstName : chr "MOIRA" "DORIS" "DORIS" "MARGARET" ...
$ LastName : chr "MACLEOD" "WALLHEAD" "WALLHEAD" "MILNE" ...
$ Ward_Dept : chr "A&E" "A&E" "Ward 02 (AMU)" "A&E" ...
$ Staging_Post : chr "A&E" "A&E" "Assessment" "A&E" ...
$ Movement_Type : chr "Departure" "Transfer Out" "Transfer In" "Departure" ...
$ IN_OUT : chr "OUT" "OUT" "IN" "OUT" ...
knitr::kable(head(data))
| MovementDateTime | FirstName | LastName | Ward_Dept | Staging_Post | Movement_Type | IN_OUT |
|---|---|---|---|---|---|---|
| 2014-09-03 00:01:00 | MOIRA | MACLEOD | A&E | A&E | Departure | OUT |
| 2014-09-03 00:03:00 | DORIS | WALLHEAD | A&E | A&E | Transfer Out | OUT |
| 2014-09-03 00:03:00 | DORIS | WALLHEAD | Ward 02 (AMU) | Assessment | Transfer In | IN |
| 2014-09-03 00:04:00 | MARGARET | MILNE | A&E | A&E | Departure | OUT |
| 2014-09-03 00:05:00 | GEORGE | EVANS | A&E | A&E | Departure | OUT |
| 2014-09-03 00:05:00 | MARJORIE | ROSS | A&E | A&E | Departure | OUT |
plot_data <- data %>%
mutate(Movement15 = lubridate::floor_date(MovementDateTime,"15 minutes")) %>%
group_by(IN_OUT, Movement_Type,Staging_Post,Movement15) %>%
mutate(counter = case_when(
IN_OUT == 'IN' ~ 1,
IN_OUT == 'OUT' ~ -1)) %>%
mutate(Movement_15_SEQNO = cumsum(counter)) %>%
ungroup()
knitr::kable(plot_data[1:6,5:10])
| Staging_Post | Movement_Type | IN_OUT | Movement15 | counter | Movement_15_SEQNO |
|---|---|---|---|---|---|
| A&E | Departure | OUT | 2014-09-03 | -1 | -1 |
| A&E | Transfer Out | OUT | 2014-09-03 | -1 | -1 |
| Assessment | Transfer In | IN | 2014-09-03 | 1 | 1 |
| A&E | Departure | OUT | 2014-09-03 | -1 | -2 |
| A&E | Departure | OUT | 2014-09-03 | -1 | -3 |
| A&E | Departure | OUT | 2014-09-03 | -1 | -4 |
plot_data$Movement_Type <- gsub("Transfer.*","Transfer",x = plot_data$Movement_Type)
knitr::kable(plot_data[1:6,5:10])
| Staging_Post | Movement_Type | IN_OUT | Movement15 | counter | Movement_15_SEQNO |
|---|---|---|---|---|---|
| A&E | Departure | OUT | 2014-09-03 | -1 | -1 |
| A&E | Transfer | OUT | 2014-09-03 | -1 | -1 |
| Assessment | Transfer | IN | 2014-09-03 | 1 | 1 |
| A&E | Departure | OUT | 2014-09-03 | -1 | -2 |
| A&E | Departure | OUT | 2014-09-03 | -1 | -3 |
| A&E | Departure | OUT | 2014-09-03 | -1 | -4 |
lims <- as.POSIXct(strptime(c("2014-09-03 00:00","2014-09-04 01:00")
, format = "%Y-%m-%d %H:%M"))
preparation step - setting axis limits in the correct time date format
ggplot(plot_data,aes(Movement15,Movement_15_SEQNO, colour = Movement_Type)) +
geom_point()
ggplot(plot_data,aes(Movement15,Movement_15_SEQNO, colour = Movement_Type)) +
geom_jitter(width = 0.10) +
scale_colour_manual(values = c("#D7100D","#40B578","grey60"))
p <- ggplot(plot_data,aes(Movement15,Movement_15_SEQNO, colour = Movement_Type)) +
geom_jitter(width = 0.10) +
scale_colour_manual(values = c("#D7100D","#40B578","grey60")) +
facet_grid(Staging_Post~., switch = "y") +
scale_x_datetime(date_labels = "%H:%M",date_breaks = "3 hours",
limits = lims,
timezone = "UTC",
expand = c(0,0))
p
p <- p + theme_ipsum(base_family = "Arial Narrow") +
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank()) +
theme(axis.text.x = element_text(size = 7)) +
theme(axis.ticks.x = element_blank()) +
theme(legend.position = "bottom") +
theme(panel.grid.minor = element_blank(),
panel.grid.major = element_blank()) +
theme(strip.text.y = element_text(angle = 180)) +
guides(color = guide_legend("Movement Type")) +
ggtitle(label = "Anytown General Hospital | Wednesday 3rd September 2014 00:00 to 23:59\n",
subtitle = "A&E AND INPATIENT ARRIVALS, DEPARTURES AND TRANSFERS") +
labs(x = NULL, y = NULL)
p
library(ggplot2)
library(extrafont)
library(hrbrthemes)
theme_set(theme_ipsum())
library(gganimate)
animation::ani.options(interval = .5,ani.width = 900, ani.height = 600, ani.res = 300)
lims <- as.POSIXct(strptime(c("2014-09-03 00:00","2014-09-04 01:00")
, format = "%Y-%m-%d %H:%M"))
p <- ggplot(plot_data,aes(Movement15,Movement_15_SEQNO, colour=Movement_Type, frame = Movement15,cumulative = TRUE))+
geom_jitter(width=0.10)+
scale_colour_manual(values=c("#D7100D","#40B578","grey60"))+
facet_grid(Staging_Post~.,switch = "y")+
scale_x_datetime(date_labels="%H:%M",date_breaks = "3 hours",
limits = lims,
timezone = "GMT",
expand = c(0,0))+
ggtitle(label = "Anytown General Hospital | Wednesday 3rd September 2014 00:00 to 23:59\n",
subtitle="A&E AND INPATIENT ARRIVALS, DEPARTURES AND TRANSFERS")+
labs(x= NULL, y= NULL,
caption="@HighlandDataSci | johnmackintosh.com Source: Neil Pettinger | @kurtstat | kurtosis.co.uk")+
theme_ipsum(base_family = "Arial Narrow")+
theme(axis.text.y=element_blank(),
axis.ticks.y=element_blank())+
theme(axis.text.x=element_text(size=7)) +
theme(axis.ticks.x=element_blank())+
theme(legend.position="bottom")+
theme(panel.grid.minor=element_blank(),
panel.grid.major=element_blank())+
theme(strip.text.y = element_text(angle = 180))+
guides(color=guide_legend("Movement Type"))+
ggExtra::removeGrid()
gganimate(p,filename = "row_of_dots_output.gif")